﻿/// /////////////////////////////////////////////
// 单元名 : MsgBaseForm
// 作者 : Hawk
// 单元描述 : 通用消息窗体基类
// 日期 : 2023-09-15
/// /////////////////////////////////////////////

{$IFDEF FPC}
{$H+}
{$MODE DELPHI}
{$ENDIF}
unit MsgBaseForm;

interface

uses
{$IFNDEF FPC}
  Windows,
{$ELSE}
  LCLIntf, LCLType, LMessages,
{$ENDIF}
  Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, ComCtrls, Dialogs, unitMsgObj,
  unitCommonDataStruct, unitDDLinkList, unitBlockSocket, unitBlockMsgClient, unitClientBuffer, BaseDialog,
  unitDataCenter, unitCommonTypes, unitIndexTable, RTTI, unitAAACommon;

type
  TfrmMsgBase = class;
  TFuncBase = class of TfrmMsgBase;

  TUIFuncInfo = record
    HostMask: TID_HOST;
    FuncName: string;
    FuncDesc: string;
    FuncBase: TFuncBase;
  end;

  PFuncInfo = ^TUIFuncInfo;

  TBindUISubClass = class(TDoubleDirLinkListItem)
  private
    FSubClassID: TDDLLItemClass;
    FCanShow: TCanShowToUI;
    FDispStr: TGetLBShowStr;
    FFillLV: TFillListItem;
  end;

  TBindUI = class(TDoubleDirLinkListItem)
  private
    FBindUI: TWinControl;
    function FindSubClass(cls: TDDLLItemClass): TBindUISubClass;
  end;

  TBindUITable = class(TDoubleDirLinkListItem)
  private
    FTableID: TID_OBJ;
    FTable: TClientObjList;
    FOnTableUpdated: TOnTableUpdated;
    FOnRecUpdated: TOnRecordUpdated;
    FOnRecDeled: TOnRecordDeled;
    function FindBindUI(ui: TWinControl): TBindUI;
  end;

  TBindUIHost = class(TDoubleDirLinkListItem)
  private
    FHost: TID_HOST;
    function FindBindTable(const tid: TID_OBJ): TBindUITable;
  end;

  TBindInfo = class(TDoubleDirLinkListItem)
  private
    function FindBindHost(const hid: TID_HOST): TBindUIHost;
  end;

  TOnShowProgress = procedure(str: string; Progress: integer = 0; ShowTime: integer = 0) of object;
  TOnNewMsgForm = function(func: TFuncBase; parentform: TfrmMsgBase): TfrmMsgBase of object;
  TGetRouteStatus = function(const hid: TID_HOST): Longword of object;
  TOnMsgFormFree = procedure(Sender: TObject) of object;
  TGetHostFilesDlg = function(Sender: TfrmMsgBase; OnlyDir: Boolean): TCommStrArr of Object;
  TOnTableChanged = procedure(Sender: TObject; const RemoteHost: TID_HOST; tbl: TClientObjList) of Object;

  TTableStores = class(TSerialObj)
  private
    FOnTableDeled: TOnTableChanged;
    FOnTableRecved: TOnTableChanged;
  public
    function HostStore(const hid: TID_HOST): TSerialObj;
    procedure AddTable(const hid: TID_HOST; tbl: TClientObjList);
    procedure RemoveTable(const hid: TID_HOST; tbl: TClientObjList);
  end;

  TfrmMsgBase = class(TForm)
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FLocalID: TID_OBJ;
    FHost: TID_HOST;
    FConfigObj: TSerialObj;
    FPreBindInfo: TBindInfo;
    FTempTableStores: TTableStores;
    FLocalConn: TBlockMsgClient;
    FSaveDialog: TSaveDialog;
    FOpenDialog: TOpenDialog;
    FDataCenterSet: TDataCenterSet;
    FUIFuncInfo: PFuncInfo;
    FOnShowProgress: TOnShowProgress;
    FOnMsgFormFree: TOnMsgFormFree;
    FGetRouteStatus: TGetRouteStatus;
    FGetHostFilesDlg: TGetHostFilesDlg;
    FCommHostName: TClientObjList;
    FFuncID: Byte;

    function GeneralListViewConfigName(lv: TListView): string;
    function GetDataCenter: TDataCenter;
    procedure ProcRecvObj(msg: TMsg);
    procedure ProcAddRecord(msg: TMsg);
    procedure ProcDelRecord(msg: TMsg);
    procedure SetGetRouteStatus(const Value: TGetRouteStatus);
    procedure SetConfigObj(const Value: TSerialObj);
  protected
    function GetMsg: TMsg;
    function CheckUIElement(CheckControl: TWinControl; CheckParam: array of const; ErrMsg: string): LongBool;
    function CommHostTbl: TClientObjList;
    function FindTableFromDataCenter(const hid: TID_HOST; const ID: TID_OBJ): TClientObjList;
    function NewConfigObj(const ID: TID_OBJ; cap: string; cls: TSerialObjClass): TSerialObj;
    function GetDevCommonName(const hid: TID_HOST): CommonString;
    function GetRecordBelongTable(rd: TSerialObj): TClientObjList;
    function SelInPeerFS(SelPath: Boolean): TCommStrArr;
    procedure GetTableFromDataCenter(const ID: TID_OBJ);
    procedure GetTableFromDataCenterSet(const hid: TID_HOST; const ID: TID_OBJ);

    procedure ShowErrorMsg(msg: string; Param: array of const);
    procedure ShowHintMsg(msg: string; Param: array of const);
    procedure UIPosFromConfig;
    procedure UIPosToConfig;
    procedure AddBindInfo(const tid: TID_OBJ; const hid: TID_HOST; ui: TWinControl; cls: TDDLLItemClass;
      CanS: TCanShowToUI; DispStr: TGetLBShowStr; FillLV: TFillListItem; OnTableUpdated: TOnTableUpdated;
      OnRecUpdated: TOnRecordUpdated; OnRecDeled: TOnRecordDeled);
    procedure UnBindUITbl(tbl: TClientObjList; ui: TWinControl); overload;
    procedure UnBindUITbl(const tid: TID_OBJ; ui: TWinControl); overload;

    procedure DoFuncFormCreated(form: TfrmMsgBase); virtual;
    procedure DoProcMsg(msg: TMsg); virtual;
    procedure DoConfigToUI; virtual;
    procedure DoUIToConfig; virtual;
    procedure WndProc(var m: TMessage); override;

    procedure SendMsg(m: TMsg); overload;
    procedure SendMsg(const Target: TID_OBJ; msgid: Longword; const tblID: TID_OBJ; data: Longword = 0;
      Param: TSerialObj = nil); overload;
    procedure GetObj(const hid: TID_HOST; const ID: TID_OBJ; NeedSubObjs: Boolean = True; FocusObjs: Boolean = True);
    procedure GetObjs(const hid: TID_HOST; ids: TObjIDArr; NeedSubObjs: Boolean = True; FocusObjs: Boolean = True);
    procedure ExecModObjProcess(ui: TWinControl; dlgcls: TdlgBaseClass; const hid: TID_HOST; const pntID: TID_OBJ;
      Config: TSerialObj);
    procedure ExecDelObjProcess(ui: TWinControl; const hid: TID_HOST);
    procedure AddRecord(const hid: TID_HOST; const pntID: TID_OBJ; rd: TSerialObj);
    procedure FetchTblRecord(const hid: TID_HOST; const tblID, objID: TID_OBJ);
    procedure DelRecord(const hid: TID_HOST; ids: TObjIDArr); overload;
    procedure DelRecord(const hid: TID_HOST; objs: TSerialObjGroup); overload;
  public
    { Public declarations }

    procedure FuncStart; virtual;
    procedure FuncStop; virtual;
    procedure TableError(const RemoteHost: TID_HOST; const ObjID: TID_OBJ; Err: ERRCODE); virtual;
    procedure TableRecved(const RemoteHost: TID_HOST; tbl: TClientObjList); virtual;
    procedure TableDeled(const RemoteHost: TID_HOST; tbl: TClientObjList); virtual;

    procedure EnableCtrls(en: BOOL);
    procedure ProcMsg(msg: TMsg);

    procedure AddDL(const ResID: TID_OBJ; LocalSavePath: CommonString);

    property FuncID: Byte read FFuncID write FFuncID;
    property LocalID: TID_OBJ read FLocalID write FLocalID;
    property PeerHost: TID_HOST read FHost write FHost;
    property UIFuncInfo: PFuncInfo read FUIFuncInfo write FUIFuncInfo;
    property ConfigObj: TSerialObj read FConfigObj write SetConfigObj;
    property DataCenter: TDataCenter read GetDataCenter;
    property TempTableStores: TTableStores read FTempTableStores write FTempTableStores;
    property DataCenterSet: TDataCenterSet read FDataCenterSet write FDataCenterSet;
    property LocalConn: TBlockMsgClient read FLocalConn write FLocalConn;
    property GetRouteStatus: TGetRouteStatus read FGetRouteStatus write SetGetRouteStatus;
    property OpenDialog: TOpenDialog read FOpenDialog write FOpenDialog;
    property SaveDialog: TSaveDialog read FSaveDialog write FSaveDialog;
    property GetHostFilesDlg: TGetHostFilesDlg read FGetHostFilesDlg write FGetHostFilesDlg;
    property OnShowProgress: TOnShowProgress read FOnShowProgress write FOnShowProgress;
    property OnMsgFormFree: TOnMsgFormFree read FOnMsgFormFree write FOnMsgFormFree;
  end;

const
  WM_PROCMSG = WM_APP + $00FF;
  S_FUNCNAME_LOGIN = '变更账户';
  I_UICHECKTYPE_NONEMPTY = 0;
  I_UICHECKTYPE_INTRANGE = 1;
  ID_FORMPOS: TID_OBJ = (IDDetail: (ObjType: 5; SubType: $6B;
    SubID: (IDBuf: ($F9, $5D, $1D, $54, $4C, $5A, $8E, $1E, $0C, $9C, $6E, $A6, $34, $AD))));

function FindFuncClass(FuncName: string): PFuncInfo;
function FuncClassCount: integer;
function GetFuncClass(idx: integer): PFuncInfo;
procedure RegFuncClass(const HostMask: TID_HOST; FuncName, FuncDesc: string; RegClass: TClass); stdcall;
procedure ProcDllLoaded;
procedure ProcDllUnload;

implementation

uses unitClassIDDef, unitMisc, unitObjPool, unitCommonIntf, unitUniqueDataCommon, unitErrCodeDef, unitSvrMngCommon,
  unitFileAndTransCommon, unitShareFileObjs, unitWinAPI;

var
  FuncClasses: array of TUIFuncInfo;

function FuncClassCount: integer;
begin
  Result := Length(FuncClasses);
end;

function GetFuncClass(idx: integer): PFuncInfo;
begin
  if (idx >= 0) and (idx < Length(FuncClasses)) then
    Result := @FuncClasses[idx]
  else
    Result := nil;
end;

function FindFuncClass(FuncName: string): PFuncInfo;
var
  i: integer;
begin
  for i := Low(FuncClasses) to High(FuncClasses) do
    if FuncClasses[i].FuncName = FuncName then
    begin
      Result := @FuncClasses[i];
      Exit;
    end;
  Result := nil;
end;

procedure RegFuncClass(const HostMask: TID_HOST; FuncName, FuncDesc: string; RegClass: TClass);
var
  l: integer;
begin
  if (FuncName <> '') and (FindFuncClass(FuncName) = nil) and (RegClass <> nil) then
  begin
    l := Length(FuncClasses);
    SetLength(FuncClasses, l + 1);
    FuncClasses[l].HostMask := HostMask;
    FuncClasses[l].FuncName := FuncName;
    FuncClasses[l].FuncDesc := FuncDesc;
    FuncClasses[l].FuncBase := TFuncBase(RegClass);
  end;
end;

var
  BackApp: TApplication;

procedure ProcDllLoaded;
var
  i: integer;
begin
  BackApp := Application;
  Application := TApplication(CommonIntf.App);
  if (CommonIntf <> nil) and Assigned(CommonIntf.RegProc) then
    for i := Low(FuncClasses) to High(FuncClasses) do
      CommonIntf.RegProc(FuncClasses[i].HostMask, FuncClasses[i].FuncName, FuncClasses[i].FuncDesc,
        FuncClasses[i].FuncBase);
end;

procedure ProcDllUnload;
begin
  Application := BackApp;
end;

{$IFNDEF FPC}
{$R *.dfm}
{$ELSE}
{$R *.lfm}
{$ENDIF}
{ TfrmMsgBase }

procedure TfrmMsgBase.AddBindInfo(const tid: TID_OBJ; const hid: TID_HOST; ui: TWinControl; cls: TDDLLItemClass;
  CanS: TCanShowToUI; DispStr: TGetLBShowStr; FillLV: TFillListItem; OnTableUpdated: TOnTableUpdated;
  OnRecUpdated: TOnRecordUpdated; OnRecDeled: TOnRecordDeled);
var
  hst: TBindUIHost;
  bt: TBindUITable;
  bui: TBindUI;
  bsubcls: TBindUISubClass;
  dc: TDataCenter;
  tbl: TClientObjList;
begin
  hst := FPreBindInfo.FindBindHost(hid);
  bt := hst.FindBindTable(tid);
  if Assigned(OnTableUpdated) then
    bt.FOnTableUpdated := OnTableUpdated;
  if Assigned(OnRecUpdated) then
    bt.FOnRecUpdated := OnRecUpdated;
  if Assigned(OnRecDeled) then
    bt.FOnRecDeled := OnRecDeled;
  if ui <> nil then
  begin
    bui := bt.FindBindUI(ui);
    if cls <> nil then
    begin
      bsubcls := bui.FindSubClass(cls);
      bsubcls.FCanShow := CanS;
      bsubcls.FDispStr := DispStr;
      bsubcls.FFillLV := FillLV;
    end;
  end;
  dc := FDataCenterSet.DCByHost(hid);
  tbl := TClientObjList(dc.FindTable(tid));
  if tbl <> nil then
    TableRecved(hid, tbl)
  else
    GetObj(hid, tid);
end;

procedure TfrmMsgBase.AddDL(const ResID: TID_OBJ; LocalSavePath: CommonString);
var
  so: TStringObj;
begin
  so := ObjPool.GetObj(TStringObj, Self);
  so.objID := ResID;
  so.str := Trim(LocalSavePath);
  so.flag := I_DL_FORCEADDDL or I_DL_NOTCHECKFILE;
  AddRecord(PeerHost, ID_DOWNLOADINGTABLE, so);
end;

procedure TfrmMsgBase.AddRecord(const hid: TID_HOST; const pntID: TID_OBJ; rd: TSerialObj);
var
  so: TStringObj;
  m: TMsg;
begin
  if rd <> nil then
  begin
    m := GetMsg;
    m.TargetObjID := MakeObjID(hid, UNIQUEDATAMODULE_ID);
    m.msgid := MESID_UNIQUEDATA_ADDOBJ;
    so := m.AddIDObj(pntID);
    so.AddObj(rd);
    SendMsg(m);
  end;
end;

function TfrmMsgBase.CheckUIElement(CheckControl: TWinControl; CheckParam: array of const; ErrMsg: string): LongBool;
var
  s: string;
  i: integer;
begin
  if CheckControl <> nil then
  begin
    Result := False;
    if Length(CheckParam) > 0 then
      case CheckParam[0].VInteger of
        I_UICHECKTYPE_NONEMPTY:
          Result := Trim(TEdit(CheckControl).Text) <> '';
        I_UICHECKTYPE_INTRANGE:
          begin
            s := '';
            try
              s := TEdit(CheckControl).Text;
              i := StrToInt(s);
              if Length(CheckParam) > 2 then
                Result := (i >= CheckParam[1].VInteger) and (i <= CheckParam[2].VInteger)
              else
                Result := True;
            except
              ShowErrorMsg('无效的整数：%s', [s]);
            end;
          end;
      end;
    if not Result then
    begin
      if ErrMsg <> '' then
        ShowErrorMsg(ErrMsg, []);
      if CheckControl.CanFocus then
        CheckControl.SetFocus;
    end;
  end
  else
    Result := True;
end;

function TfrmMsgBase.CommHostTbl: TClientObjList;
begin
  Result := FCommHostName;
  if FCommHostName = nil then
    GetTableFromDataCenterSet(FLocalID.IDDetail.SvrMdl.HostID, ID_COMMONUSEHOSTTABLE);
end;

procedure TfrmMsgBase.DelRecord(const hid: TID_HOST; objs: TSerialObjGroup);
var
  m: TMsg;
  i: integer;
begin
  m := GetMsg;
  m.TargetObjID := MakeObjID(hid, UNIQUEDATAMODULE_ID);
  m.msgid := MESID_UNIQUEDATA_DELOBJ;
  for i := Low(objs) to High(objs) do
    m.AddIDObj(objs[i].objID);
  SendMsg(m);
end;

procedure TfrmMsgBase.DelRecord(const hid: TID_HOST; ids: TObjIDArr);
var
  m: TMsg;
  i: integer;
begin
  m := GetMsg;
  m.TargetObjID := MakeObjID(hid, UNIQUEDATAMODULE_ID);
  m.msgid := MESID_UNIQUEDATA_DELOBJ;
  for i := Low(ids) to High(ids) do
    m.AddIDObj(ids[i]);
  SendMsg(m);
end;

procedure TfrmMsgBase.DoConfigToUI;
var
  s4: TSize4DataSet;
begin
  s4 := TSize4DataSet(FConfigObj.FindItemLowerLevel(ID_FORMPOS));
  if s4 <> nil then
  begin
    Left := s4.GetData(0);
    Top := s4.GetData(1);
    Width := s4.GetData(2);
    Height := s4.GetData(3);
  end;
end;

procedure TfrmMsgBase.DoFuncFormCreated(form: TfrmMsgBase);
begin

end;

procedure TfrmMsgBase.DoProcMsg(msg: TMsg);
begin
  case msg.msgid of
    MESID_ACCESS_DENIED:
      ShowErrorMsg('访问被拒绝，请确认您拥有相关权限', []);
    MESID_INVALID_REQUEST:
      ShowErrorMsg('无效访问请求，请确认您的访问', []);
    MESID_UNIQUEDATA_RESP_GETOBJ:
      ProcRecvObj(msg);
    MESID_UNIQUEDATA_ADDOBJ, MESID_UNIQUEDATA_RESP_ADDOBJ:
      ProcAddRecord(msg);
    MESID_UNIQUEDATA_DELOBJ, MESID_UNIQUEDATA_RESP_DELOBJ:
      ProcDelRecord(msg);
  end;
end;

procedure TfrmMsgBase.DoUIToConfig;
var
  s4: TSize4DataSet;
begin
  s4 := TSize4DataSet(FConfigObj.FindItemLowerLevel(ID_FORMPOS));
  if s4 = nil then
  begin
    s4 := ObjPool.GetObj(TSize4DataSet, Self);
    s4.objID := ID_FORMPOS;
    FConfigObj.AddObj(s4);
  end;
  s4.SetData(0, Left);
  s4.SetData(1, Top);
  s4.SetData(2, Width);
  s4.SetData(3, Height);
end;

procedure TfrmMsgBase.EnableCtrls(en: BOOL);
var
  i: integer;
begin
  for i := 0 to ControlCount - 1 do
    Controls[i].Enabled := en;
end;

procedure TfrmMsgBase.ExecModObjProcess(ui: TWinControl; dlgcls: TdlgBaseClass; const hid: TID_HOST;
  const pntID: TID_OBJ; Config: TSerialObj);
var
  o, tmpo: TSerialObj;
begin
  if dlgcls <> nil then
  begin
    o := nil;
    case CheckControlSupport(ui) of
      suicListBox:
        if TListBox(ui).ItemIndex <> -1 then
          o := TSerialObj(TListBox(ui).Items.Objects[TListBox(ui).ItemIndex]);
      suicListView:
        if TListView(ui).Selected <> nil then
          o := TListView(ui).Selected.data;
      suicTreeView:
        if TTreeView(ui).Selected <> nil then
          o := TTreeView(ui).Selected.data;
      suicComboBox:
        if TComboBox(ui).ItemIndex <> -1 then
          o := TSerialObj(TComboBox(ui).Items.Objects[TComboBox(ui).ItemIndex]);
    end;
    tmpo := dlgcls.ShowInfoDlg(PeerHost, FLocalID.IDDetail.SvrMdl.HostID, DataCenterSet, o, Config);
    if tmpo <> nil then
      AddRecord(hid, pntID, tmpo);
  end;
end;

procedure TfrmMsgBase.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmMsgBase.FormCreate(Sender: TObject);
begin
  FPreBindInfo := TBindInfo.Create;
end;

procedure TfrmMsgBase.FormDestroy(Sender: TObject);
begin
  DoUIToConfig;
  UIPosToConfig;
  if Assigned(FOnMsgFormFree) then
    FOnMsgFormFree(Self);
  FuncStop;
  FPreBindInfo.Free;
end;

procedure TfrmMsgBase.FuncStart;
begin
  CommHostTbl;
end;

procedure TfrmMsgBase.FuncStop;
var
  bh: TBindUIHost;
  bt: TBindUITable;
  ui: TBindUI;
  dc: TDataCenter;
begin
  bh := TBindUIHost(FPreBindInfo.Item[0]);
  while bh <> nil do
  begin
    bt := TBindUITable(bh.Item[0]);
    while bt <> nil do
    begin
      if bt.FTable <> nil then
      begin
        if Assigned(bt.FOnTableUpdated) then
          bt.FTable.DelTblUpdated(bt.FOnTableUpdated);
        if Assigned(bt.FOnRecUpdated) then
          bt.FTable.DelRdUpdated(bt.FOnRecUpdated);
        if Assigned(bt.FOnRecDeled) then
          bt.FTable.DelRdDeled(bt.FOnRecDeled);
        ui := TBindUI(bt.Item[0]);
        while ui <> nil do
        begin
          bt.FTable.UIFree(ui.FBindUI);
          ui := TBindUI(ui.Next);
        end;
        if (bt.FTable.RegedEventNotifyCount = 0) and (bt.FTable.UIItemCount = 0) then
        begin
          dc := DataCenterSet.DCByHost(bh.FHost);
          dc.RemoveTable(bt.FTable);
        end;
      end;
      bt := TBindUITable(bt.Next);
    end;
    bh := TBindUIHost(bh.Next);
  end;
end;

function TfrmMsgBase.GeneralListViewConfigName(lv: TListView): string;
begin
  Result := Name + '_' + lv.name;
end;

function TfrmMsgBase.GetDataCenter: TDataCenter;
begin
  Result := FDataCenterSet.DCByHost(FHost);
end;

function TfrmMsgBase.GetDevCommonName(const hid: TID_HOST): CommonString;
var
  hfi: THostFriendInfo;
begin
  Result := '';
  if FCommHostName <> nil then
  begin
    hfi := THostFriendInfo(FCommHostName.FindItemLowerLevel(MakeObjID(hid, EMPTY_ID_MODULE)));
    if hfi <> nil then
      if hfi.FriendName <> '' then
        Result := hfi.FriendName
      else
        Result := hfi.HostName;
  end;
end;

function TfrmMsgBase.GetMsg: TMsg;
begin
  Result := ObjPool.GetObj(TMsg, Self);
  Result.SourceObjID := FLocalID;
end;

procedure TfrmMsgBase.GetObj(const hid: TID_HOST; const ID: TID_OBJ; NeedSubObjs, FocusObjs: Boolean);
var
  m: TMsg;
  so: TStringObj;
begin
  m := GetMsg;
  m.TargetObjID := MakeObjID(hid, UNIQUEDATAMODULE_ID);
  m.msgid := MESID_UNIQUEDATA_GETOBJ;
  // m.CommID :=;
  so := m.AddIDObj(ID);
  if NeedSubObjs then
    so.flag := L_GETOBJFLAG_NEEDSUBOBJS;
  if FocusObjs then
    so.flag := so.flag or L_GETOBJFLAG_FOCUSOBJS;
  SendMsg(m);
end;

procedure TfrmMsgBase.GetObjs(const hid: TID_HOST; ids: TObjIDArr; NeedSubObjs, FocusObjs: Boolean);
var
  m: TMsg;
  so: TStringObj;
  i: integer;
begin
  m := GetMsg;
  m.TargetObjID := MakeObjID(hid, UNIQUEDATAMODULE_ID);
  m.msgid := MESID_UNIQUEDATA_GETOBJ;
  // m.CommID :=;
  for i := Low(ids) to High(ids) do
  begin
    so := m.AddIDObj(ids[i]);
    if NeedSubObjs then
      so.flag := L_GETOBJFLAG_NEEDSUBOBJS;
    if FocusObjs then
      so.flag := so.flag or L_GETOBJFLAG_FOCUSOBJS;
  end;
  SendMsg(m);
end;

function TfrmMsgBase.GetRecordBelongTable(rd: TSerialObj): TClientObjList;
begin
  Result := TClientObjList(rd);
  while Result <> nil do
  begin
    if Result.ClassID = CLASSID_DATATABLE then
      Break;
    Result := TClientObjList(Result.Parent);
  end;
end;

procedure TfrmMsgBase.FetchTblRecord(const hid: TID_HOST; const tblID, objID: TID_OBJ);
var
  m: TMsg;
begin
  m := GetMsg;
  m.TargetObjID := MakeObjID(hid, UNIQUEDATAMODULE_ID);
  m.objID := tblID;
  m.AddIDObj(objID);
  SendMsg(m);
end;

function TfrmMsgBase.FindTableFromDataCenter(const hid: TID_HOST; const ID: TID_OBJ): TClientObjList;
var
  dc: TDataCenter;
begin
  dc := FDataCenterSet.DCByHost(hid);
  Result := TClientObjList(dc.FindTable(ID));
end;

procedure TfrmMsgBase.GetTableFromDataCenter(const ID: TID_OBJ);
var
  dc: TDataCenter;
  tbl: TClientObjList;
begin
  dc := FDataCenterSet.DCByHost(FHost);
  tbl := TClientObjList(dc.FindTable(ID));
  if tbl = nil then
    GetObj(FHost, ID)
  else
    TableRecved(FHost, tbl);
end;

procedure TfrmMsgBase.GetTableFromDataCenterSet(const hid: TID_HOST; const ID: TID_OBJ);
var
  dc: TDataCenter;
begin
  dc := FDataCenterSet.DCByHost(hid);
  if dc.FindTable(ID) = nil then
    GetObj(hid, ID);
end;

function TfrmMsgBase.NewConfigObj(const ID: TID_OBJ; cap: string; cls: TSerialObjClass): TSerialObj;
begin
  if not ID.IsEmpty then
    Result := FConfigObj.FindItemLowerLevel(ID)
  else if (cap <> '') then
    Result := FConfigObj.FindItemLowerLevel(cap)
  else
    Result := nil;
  if (Result = nil) then
  begin
    Result := ObjPool.GetObj(cls, Self);
    Result.objID := ID;
    Result.Caption := cap;
    FConfigObj.AddObj(Result);
  end;
end;

procedure TfrmMsgBase.ProcAddRecord(msg: TMsg);
var
  tbl, subtbl: TClientObjList;
  so: TSerialObj;
  po, o: TSerialObj;
  dc: TDataCenter;
begin
  if msg.Error <> ERRCODE_NOERROR then
    DbgPrint('增加或者修改记录的时候错误：%s', [ErrCodeToStr(msg.Error)])
  else
  begin
    dc := FDataCenterSet.DCByHost(msg.SourceObjID.IDDetail.SvrMdl.HostID);
    while msg.Count > 0 do
    begin
      so := msg.Obj[0];
      if (so <> nil) and (so.Count > 0) then
      begin
        po := dc.FindPrimyObj(so.objID);
        if po <> nil then
        begin
          tbl := GetRecordBelongTable(po);
          if tbl <> nil then
            while so.Count > 0 do
            begin
              o := tbl.UpdateObj(so.objID, so.Obj[0]);
              dc.AddObjEntry(o);
              subtbl := TClientObjList(tbl.FindItem(so.objID));
              if (subtbl <> nil) and (subtbl <> tbl) and (subtbl.IsInherited(TClientObjList.ClassID)) then
                subtbl.FreshUI;
            end;
        end;
        ObjPool.ReturnObj(so, Self);
      end
      else
        Break;
    end;
  end;
end;

procedure TfrmMsgBase.ProcDelRecord(msg: TMsg);
var
  tbl: TClientObjList;
  so: TStringObj;
  o: TSerialObj;
  dc: TDataCenter;
begin
  if msg.Error = ERRCODE_NOERROR then
  begin
    dc := FDataCenterSet.DCByHost(msg.SourceObjID.IDDetail.SvrMdl.HostID);
    while msg.Count > 0 do
    begin
      so := msg.Param(TStringObj);
      if so <> nil then
      begin
        o := dc.FindPrimyObj(so.objID);
        if o <> nil then
        begin
          tbl := GetRecordBelongTable(o);
          if tbl <> nil then
          begin
            dc.DelObjEntry(o);
            tbl.DelObj(o);
          end;
        end;
        ObjPool.ReturnObj(so, Self);
      end
      else
        Break;
    end;
  end
  else if msg.Error <> ERRCODE_PENDOPE then
    DbgPrint('删除记录的时候错误：%s', [ErrCodeToStr(msg.Error)])
end;

procedure TfrmMsgBase.ProcMsg(msg: TMsg);
begin
  DoProcMsg(msg);
end;

procedure TfrmMsgBase.ProcRecvObj(msg: TMsg);
var
  Obj, lobj: TSerialObj;
  dc: TDataCenter;
begin
  dc := FDataCenterSet.DCByHost(msg.SourceObjID.IDDetail.SvrMdl.HostID);
  if msg.Error = ERRCODE_NOERROR then
    while msg.Count > 0 do
    begin
      Obj := TSerialObj(msg.Item[0]);
      lobj := dc.FindObj(Obj.objID, Obj.ClassID);
      if lobj <> nil then
      begin
        if lobj.IsInherited(CLASSID_DATATABLE) then
        begin
          dc.DelObjEntry(lobj);
          TClientObjList(lobj).SetLastError(msg.Error);
          TClientObjList(lobj).UpdateList(Obj);
          dc.AddObjEntry(lobj);
          ObjPool.ReturnObj(Obj, Self);
        end
        else
          lobj.Update(Obj);
      end
      else if Obj.IsInherited(CLASSID_DATATABLE) then
      begin
        DbgPrint('DataCenter recv new Table %s(%d)', [Obj.Caption, Obj.Count]);
        FTempTableStores.AddTable(msg.SourceObjID.IDDetail.SvrMdl.HostID, TClientObjList(Obj));
        msg.DelObj(Obj);
        dc.AddObjEntry(Obj);
        TClientObjList(Obj).AllowSameName := True;
        TClientObjList(Obj).SetLastError(msg.Error);
        TableRecved(msg.SourceObjID.IDDetail.SvrMdl.HostID, TClientObjList(Obj));
      end
      else
        ObjPool.ReturnObj(Obj, Self);
    end
  else
    while msg.Count > 0 do
    begin
      Obj := TSerialObj(msg.Item[0]);
      lobj := dc.FindObj(Obj.ObjID, CLASSID_DATATABLE);
      if (lobj <> nil) then
      begin
        TClientObjList(lobj).SetLastError(msg.Error);
        TClientObjList(lobj).FreshUI;
      end
      else
        TableError(msg.SourceObjID.IDDetail.SvrMdl.HostID, Obj.ObjID, msg.Error);
    end;
end;

procedure TfrmMsgBase.SendMsg(m: TMsg);
begin
  if FLocalConn <> nil then
    FLocalConn.SendMsg(m)
  else
    ObjPool.ReturnObj(m, Self);
end;

procedure TfrmMsgBase.ExecDelObjProcess(ui: TWinControl; const hid: TID_HOST);
var
  o: TSerialObj;
  m: TMsg;
  s: TStringObj;
  i: integer;

  procedure ColTreeSel(tn: TTreeNode);
  var
    j: integer;
  begin
    if tn.Selected then
    begin
      o := TSerialObj(tn.data);
      if o <> nil then
      begin
        s := ObjPool.GetObj(TStringObj, Self);
        s.objID := o.objID;
        m.AddObj(s);
      end;
    end;
    for j := 0 to tn.Count - 1 do
      ColTreeSel(tn.{$IFDEF FPC}Items{$ELSE}Item{$ENDIF}[j]);
  end;

begin
  if ui <> nil then
  begin
    m := GetMsg;
    m.TargetObjID := MakeObjID(hid, UNIQUEDATAMODULE_ID);
    m.msgid := MESID_UNIQUEDATA_DELOBJ;
    case CheckControlSupport(ui) of
      suicListBox:
        case TListBox(ui).SelCount of
          0:
            ;
          1:
            begin
              o := TSerialObj(TListBox(ui).Items.Objects[TListBox(ui).ItemIndex]);
              if o <> nil then
                m.AddIDObj(o.objID);
            end;
        else
          begin
            for i := 0 to TListBox(ui).Items.Count - 1 do
              if TListBox(ui).Selected[i] then
              begin
                o := TSerialObj(TListBox(ui).Items.Objects[i]);
                if o <> nil then
                  m.AddIDObj(o.objID);
              end;
          end;
        end;
      suicListView:
        case TListView(ui).SelCount of
          0:
            ;
          1:
            begin
              o := TSerialObj(TListView(ui).Selected.data);
              if o <> nil then
                m.AddIDObj(o.objID);
            end;
        else
          begin
            for i := 0 to TListView(ui).Items.Count - 1 do
              if TListView(ui).Items.Item[i].Selected then
              begin
                o := TSerialObj(TListView(ui).Items.Item[i].data);
                if o <> nil then
                  m.AddIDObj(o.objID);
              end;
          end;
        end;
      suicTreeView:
        for i := 0 to TTreeView(ui).Items.Count - 1 do
          ColTreeSel(TTreeView(ui).Items.Item[i]);
      suicComboBox:
        begin
          o := TSerialObj(TComboBox(ui).Items.Objects[TComboBox(ui).ItemIndex]);
          if o <> nil then
            m.AddIDObj(o.objID);
        end;
    end;
    SendMsg(m);
  end;
end;

function TfrmMsgBase.SelInPeerFS(SelPath: Boolean): TCommStrArr;
var
  i: integer;
begin
  if LocalID.IDDetail.SvrMdl.HostID = PeerHost then
  begin
    if SelPath then
    begin
      SetLength(Result, 1);
      Result[0] := SelectFolder(Handle, '请选择路径');
    end
    else if OpenDialog.Execute(Handle) then
      for i := 0 to OpenDialog.Files.Count - 1 do
        AddStrToArr(Result, OpenDialog.Files.Strings[i]);
  end
  else if Assigned(FGetHostFilesDlg) then
    Result := FGetHostFilesDlg(Self, SelPath);
end;

procedure TfrmMsgBase.SendMsg(const Target: TID_OBJ; msgid: Longword; const tblID: TID_OBJ; data: Longword;
  Param: TSerialObj);
begin
  if (FLocalConn <> nil) and FLocalConn.Normal then
    FLocalConn.SendMsg(Target, FLocalID, msgid, tblID, Param, data);
end;

procedure TfrmMsgBase.SetConfigObj(const Value: TSerialObj);
begin
  FConfigObj := Value;
  DoConfigToUI;
  UIPosFromConfig;
end;

procedure TfrmMsgBase.SetGetRouteStatus(const Value: TGetRouteStatus);
begin
  FGetRouteStatus := Value;
end;

procedure TfrmMsgBase.ShowErrorMsg(msg: string; Param: array of const);
begin
  msg := Format(msg, Param);
  MessageBox(Handle, PChar(msg), '错误', MB_OK or MB_ICONSTOP);
end;

procedure TfrmMsgBase.ShowHintMsg(msg: String; Param: array of const);
begin
  msg := Format(msg, Param);
  MessageBox(Handle, PChar(msg), '信息', MB_OK or MB_ICONINFORMATION);
end;

procedure TfrmMsgBase.TableDeled(const RemoteHost: TID_HOST; tbl: TClientObjList);
var
  bh: TBindUIHost;
  bt: TBindUITable;
  bui: TBindUI;
begin
  if tbl <> nil then
  begin
    bh := FPreBindInfo.FindBindHost(RemoteHost);
    bt := bh.FindBindTable(tbl.objID);
    if Assigned(bt.FOnTableUpdated) then
      tbl.DelTblUpdated(bt.FOnTableUpdated);
    if Assigned(bt.FOnRecUpdated) then
      tbl.DelRdUpdated(bt.FOnRecUpdated);
    if Assigned(bt.FOnRecDeled) then
      tbl.DelRdDeled(bt.FOnRecDeled);
    bui := TBindUI(bt.Item[0]);
    while bui <> nil do
    begin
      tbl.UIFree(bui.FBindUI);
      bui := TBindUI(bui.Next);
    end;
  end;
end;

procedure TfrmMsgBase.TableError(const RemoteHost: TID_HOST; const ObjID: TID_OBJ; Err: ERRCODE);
begin

end;

procedure TfrmMsgBase.TableRecved(const RemoteHost: TID_HOST; tbl: TClientObjList);
var
  bh: TBindUIHost;
  bt: TBindUITable;
  bui: TBindUI;
  buc: TBindUISubClass;
begin
  if (RemoteHost = LocalID.IDDetail.SvrMdl.HostID) and (tbl.objID = ID_COMMONUSEHOSTTABLE) then
    FCommHostName := tbl;
  bh := FPreBindInfo.FindBindHost(RemoteHost);
  if tbl <> nil then
  begin
    bt := bh.FindBindTable(tbl.objID);
    bt.FTable := tbl;
    if Assigned(bt.FOnTableUpdated) then
      tbl.AddTblUpdated(bt.FOnTableUpdated);
    if Assigned(bt.FOnRecUpdated) then
      tbl.AddRdUpdated(bt.FOnRecUpdated);
    if Assigned(bt.FOnRecDeled) then
      tbl.AddRdDeled(bt.FOnRecDeled);
    if bt.Count > 0 then
    begin
      bui := TBindUI(bt.Item[0]);
      while bui <> nil do
      begin
        buc := TBindUISubClass(bui.Item[0]);
        while buc <> nil do
        begin
          tbl.BindUI(bui.FBindUI, buc.FSubClassID, buc.FCanShow, buc.FDispStr, buc.FFillLV);
          buc := TBindUISubClass(buc.Next);
        end;
        bui := TBindUI(bui.Next);
      end;
    end
    else
      tbl.NotifyTableUpdated(EMPTY_ID_OBJ, EMPTY_ID_OBJ);
  end;
end;

procedure TfrmMsgBase.UIPosFromConfig;

  procedure ReadListViewColSize(ui: TWinControl);
  var
    i: integer;
    s: TSize4DataSet;
    lv: TListView;
    j: integer;
    ss: string;
  begin
    for i := 0 to ui.ControlCount - 1 do
      if ui.Controls[i].ClassType = TListView then
      begin
        lv := TListView(ui.Controls[i]);
        ss := GeneralListViewConfigName(lv);
        s := TSize4DataSet(NewConfigObj(EMPTY_ID_OBJ, ss, TSize4DataSet));
        if s.DataCount >= lv.Columns.Count then
          for j := 0 to lv.Columns.Count - 1 do
            lv.Columns.Items[j].Width := s.GetData(j);
      end
      else if ui.Controls[i].InheritsFrom(TWinControl) then
        ReadListViewColSize(TWinControl(ui.Controls[i]));
  end;

begin
  if FConfigObj <> nil then
    ReadListViewColSize(Self);
end;

procedure TfrmMsgBase.UIPosToConfig;

  procedure SaveListViewColSize(ui: TWinControl);
  var
    i: integer;
    s: TSize4DataSet;
    lv: TListView;
    j: integer;
    ss: string;
  begin
    for i := 0 to ui.ControlCount - 1 do
      if ui.Controls[i].ClassType = TListView then
      begin
        lv := TListView(ui.Controls[i]);
        ss := GeneralListViewConfigName(lv);
        s := TSize4DataSet(NewConfigObj(EMPTY_ID_OBJ, ss, TSize4DataSet));
        for j := 0 to lv.Columns.Count - 1 do
          s.SetData(j, lv.Columns.Items[j].Width);
      end
      else if ui.Controls[i].InheritsFrom(TWinControl) then
        SaveListViewColSize(TWinControl(ui.Controls[i]));
  end;

begin
  if FConfigObj <> nil then
    SaveListViewColSize(Self);
end;

procedure TfrmMsgBase.UnBindUITbl(tbl: TClientObjList; ui: TWinControl);
begin
  if tbl <> nil then
  begin
    tbl.UIFree(ui);
    if tbl.BindUICount = 0 then
    begin
      SendMsg(MakeObjID(PeerHost, UNIQUEDATAMODULE_ID), MESID_UNIQUEDATA_UNFOCUSRESOURCE, tbl.objID);
      DataCenter.RemoveTable(tbl);
    end;
  end;
end;

procedure TfrmMsgBase.UnBindUITbl(const tid: TID_OBJ; ui: TWinControl);
var
  t: TClientObjList;
begin
  t := FindTableFromDataCenter(PeerHost, tid);
  UnBindUITbl(t, ui);
end;

procedure TfrmMsgBase.WndProc(var m: TMessage);
var
  msg: unitMsgObj.TMsg;
begin
  case m.msg of
    WM_PROCMSG:
      begin
        msg := unitMsgObj.TMsg(m.wParam);
        DoProcMsg(msg);
        ObjPool.ReturnObj(msg, Self);
      end
  else
    inherited;
  end;
end;

{ TTableStores }

procedure TTableStores.AddTable(const hid: TID_HOST; tbl: TClientObjList);
var
  hst: TSerialObj;
  th: TClientObjList;
begin
  hst := HostStore(hid);
  th := TClientObjList(hst.FindItemLowerLevel(tbl.objID));
  if (th <> tbl) then
  begin
    th.Free;
    AppendItem(tbl);
  end;
end;

function TTableStores.HostStore(const hid: TID_HOST): TSerialObj;
begin
  Result := TSerialObj(Item[0]);
  while Result <> nil do
  begin
    if Result.objID.IDDetail.SvrMdl.HostID = hid then
      Exit;
    Result := TSerialObj(Result.Next);
  end;
  Result := TSerialObj.Create;
  Result.objID := MakeObjID(hid, EMPTY_ID_MODULE);
  AppendItem(Result);
end;

procedure TTableStores.RemoveTable(const hid: TID_HOST; tbl: TClientObjList);
var
  hst: TSerialObj;
  th: TClientObjList;
begin
  hst := HostStore(hid);
  th := TClientObjList(hst.FindItemLowerLevel(tbl.objID));
  if th <> nil then
  begin
    if Assigned(FOnTableDeled) then
      FOnTableDeled(Self, hid, tbl);
    tbl.Free;
  end;
end;

{ TBindUIHost }

function TBindUIHost.FindBindTable(const tid: TID_OBJ): TBindUITable;
begin
  Result := TBindUITable(Item[0]);
  while Result <> nil do
  begin
    if Result.FTableID = tid then
      Exit;
    Result := TBindUITable(Result.Next);
  end;
  Result := TBindUITable.Create;
  Result.FTableID := tid;
  AppendItem(Result);
end;

{ TBindUITable }

function TBindUITable.FindBindUI(ui: TWinControl): TBindUI;
begin
  Result := TBindUI(Item[0]);
  while Result <> nil do
  begin
    if Result.FBindUI = ui then
      Exit;
    Result := TBindUI(Result.Next);
  end;
  Result := TBindUI.Create;
  Result.FBindUI := ui;
  AppendItem(Result);
end;

{ TBindUI }

function TBindUI.FindSubClass(cls: TDDLLItemClass): TBindUISubClass;
begin
  Result := TBindUISubClass(Item[0]);
  while Result <> nil do
  begin
    if Result.FSubClassID = cls then
      Exit;
    Result := TBindUISubClass(Result.Next);
  end;
  Result := TBindUISubClass.Create;
  Result.FSubClassID := cls;
  AppendItem(Result);
end;

{ TBindInfo }

function TBindInfo.FindBindHost(const hid: TID_HOST): TBindUIHost;
begin
  Result := TBindUIHost(Item[0]);
  while Result <> nil do
  begin
    if Result.FHost = hid then
      Exit;
    Result := TBindUIHost(Result.Next);
  end;
  Result := TBindUIHost.Create;
  Result.FHost := hid;
  AppendItem(Result);
end;

initialization

LoadedProc := ProcDllLoaded;
UnLoadProc := ProcDllUnload;

end.
